home *** CD-ROM | disk | FTP | other *** search
/ FM Towns: Free Software Collection 10 / FM Towns Free Software Collection 10.iso / fb386 / tool / edit / edit.bas next >
BASIC Source File  |  1995-02-11  |  11KB  |  257 lines
  1. 10 CLEAR ,,1024,400000:COLOR 7,0,7,0:CONSOLE 0,25,0
  2. 20 ON ERROR GOTO *ER
  3. 30 PLAY OFF:SCREEN@ 0:CLS:PALETTE:DIM A%(10),B%(100),RGB(15,2),H%(500),SC%(63),X%(4095),ZZ%(20000),GTPT%(63):W=200:XAX=0:YAY=0:MSX=112:MSY=112
  4. 40 FOR I=0 TO 15:FOR II=0 TO 2:READ RGB(I,II):NEXT:NEXT
  5. 50 FOR I=0 TO 15:R=RGB(I,0):G=RGB(I,1):B=RGB(I,2):PALETTE I,[G*8,R*8,B*8],1:NEXT
  6. 60 FOR I=0 TO 16
  7. 70 LINE(200+I*20,80)-(200+I*20,400),PSET,7
  8. 80 LINE(200,80+I*20)-(520,80+I*20),PSET,7
  9. 90 NEXT
  10. 100 GET@(200,80)-(519,399),ZZ%,7
  11. 110 LINE(200,80)-(220,100),PSET,0,B:LINE(620,400)-(639,420),PSET,7,B
  12. 120 FOR I=1 TO 15
  13. 130 LINE(630,100+I*10)-(639,110+I*10),PSET,%I,BF
  14. 140 NEXT
  15. 150 XX=0:YY=0:COL=0:P=0
  16. 160 SYMBOL(196,10),"･PALETTE･ WAIT  ･ SAVE  ･ LOAD  ･  CLS  ･",1,1,7
  17. 170 SYMBOL(196,30),"･  GET  ･  PUT  ･SCROLL ･POW_OFF･  END  ･",1,1,7
  18. 180 FOR J=0 TO 8
  19. 190 PSET(200+J*40,59),7:PSET(200+J*40,71),7
  20. 200 PSET(541,80+J*40),7:PSET(529,80+J*40),7
  21. 210 NEXT
  22. 220 LINE(200,60)-(520,70),PSET,7,B
  23. 230 LINE(530,80)-(540,400),PSET,7,B
  24. 240 LINE(200,60)-(240,70),PSET,7,BF
  25. 250 LINE(530,80)-(540,120),PSET,7,BF
  26. 260 LINE(0,128)-(128,128),PSET,7
  27. 270 LINE(128,0)-(128,128),PSET,7
  28. 280 '
  29. 1000 '========メインルーチン========
  30. 1010 WHILE P=0
  31. 1020 PD=PAD(1):PT=PTRIG(1)
  32. 1030 FOR Z=0 TO W:NEXT
  33. 1040 IF PD=1 AND YY<>0 THEN GOSUB *PL:YY=YY-1:GOSUB *DL:GOTO 1070
  34. 1050 IF PT<>1 AND PD=1 AND YY=0 AND YAY<>0 THEN YAY=YAY-1:GOSUB *PL ELSE 1070
  35. 1060 GOSUB *SCRB:GOSUB *CHARA_LOAD:GOSUB *DL
  36. 1070 IF PD=3 AND XX<>15 THEN GOSUB *PL:XX=XX+1:GOSUB *DL:GOTO 1100
  37. 1080 IF PT<>1 AND PD=3 AND XX=15 AND XAX<>MSX THEN XAX=XAX+1:GOSUB *PL ELSE 1100
  38. 1090 GOSUB *SCRB:GOSUB *CHARA_LOAD:GOSUB *DL
  39. 1100 IF PD=5 AND YY<>15 THEN GOSUB *PL:YY=YY+1:GOSUB *DL:GOTO 1130
  40. 1110 IF PT<>1 AND PD=5 AND YY=15 AND YAY<>MSY THEN YAY=YAY+1:GOSUB *PL ELSE 1130
  41. 1120 GOSUB *SCRB:GOSUB *CHARA_LOAD:GOSUB *DL
  42. 1130 IF PD=7 AND XX<>0 THEN GOSUB *PL:XX=XX-1:GOSUB *DL:GOTO 1160
  43. 1140 IF PT<>1 AND PD=7 AND XX=0 AND XAX<>0 THEN XAX=XAX-1:GOSUB *PL ELSE 1160
  44. 1150 GOSUB *SCRB:GOSUB *CHARA_LOAD:GOSUB *DL
  45. 1160 IF PTRIG(1)=1 THEN LINE(201+XX*20,81+YY*20)-(219+XX*20,99+YY*20),PSET,%COL,BF:GOSUB *GP
  46. 1170 IF PTRIG(1)=2 THEN PLAY "C16":COL=COL+1:WAIT 20
  47. 1180 IF COL=16 THEN COL=0:LINE(620,400)-(639,420),PSET,0,BF:LINE(620,400)-(639,420),PSET,7,B:GOTO 1010
  48. 1190 IF COL<>0 THEN LINE(620,400)-(639,420),PSET,%COL,BF
  49. 1200 IF PTRIG(1)=4 THEN WAIT 10:GOTO *MENU
  50. 1210 IF PTRIG(1)=8 THEN WAIT 10:GOTO 1240
  51. 1220 WEND
  52. 1230 '
  53. 1240 P=0
  54. 1250 LINE(612,102+COL*10)-(616,107+COL*10),PSET,7,BF
  55. 1260 WAIT 20
  56. 1270 '
  57. 2000 '========パレット変更ルーチン========
  58. 2010 WHILE P=0
  59. 2020 FOR Z=0 TO W*2:NEXT
  60. 2030 IF PAD(1)=1 AND COL<>0 THEN COL=COL-1:LINE(612,102+COL*10)-(616,107+COL*10),PSET,7,BF:LINE(612,112+COL*10)-(616,117+COL*10),PSET,0,BF:IF COL<>0 THEN LINE(620,400)-(639,420),PSET,%COL,BF
  61. 2040 IF COL=0 AND POINT(630,410)=-1 THEN LINE(620,400)-(639,420),PSET,0,BF:LINE(620,400)-(639,420),PSET,7,B
  62. 2050 IF PAD(1)=5 AND COL<>15 THEN COL=COL+1:LINE(612,102+COL*10)-(616,107+COL*10),PSET,7,BF:LINE(612,92+COL*10)-(616,97+COL*10),PSET,0,BF:IF COL<>0 THEN LINE(620,400)-(639,420),PSET,%COL,BF
  63. 2060 IF PTRIG(1)=2 THEN WAIT 20:LINE(612,92)-(616,257),PSET,0,BF:GOTO *MENU
  64. 2070 IF PTRIG(1)=8 THEN WAIT 20:LINE(202,8)-(261,26),PSET,0,B:LINE(612,92)-(616,257),PSET,0,BF:GOTO 1010
  65. 2080 IF PTRIG(1)=1 THEN P=1:WAIT 10
  66. 2090 WEND
  67. 2100 '
  68. 2110 P=0:Q=0
  69. 2120 LINE(550,300)-(610,436),PSET,7,B
  70. 2130 LINE(553,303)-(567,433),PSET,7,B
  71. 2140 R=RGB(COL,0):G=RGB(COL,1):B=RGB(COL,2)
  72. 2150 LINE(555,306)-(565,306+R*4),PSET,7,BF
  73. 2160 LINE(575,306)-(585,306+G*4),PSET,7,BF
  74. 2170 LINE(595,306)-(605,306+B*4),PSET,7,BF
  75. 2180 '
  76. 2190 WHILE P=0
  77. 2200 IF PAD(1)=1 AND RGB(COL,Q)<>0 THEN :LINE(555+Q*20,302+RGB(COL,Q)*4)-(565+Q*20,430),PSET,0,BF:RGB(COL,Q)=RGB(COL,Q)-1:R=RGB(COL,0):G=RGB(COL,1):B=RGB(COL,2):PALETTE COL,[G*8,R*8,B*8],1:GOTO 2140
  78. 2210 IF PAD(1)=5 AND RGB(COL,Q)<>31 THEN :RGB(COL,Q)=RGB(COL,Q)+1:R=RGB(COL,0):G=RGB(COL,1):B=RGB(COL,2):PALETTE COL,[G*8,R*8,B*8],1:GOTO 2140
  79. 2220 IF PAD(1)=3 AND Q<>2 THEN LINE(553+Q*20,303)-(567+Q*20,433),PSET,0,B:Q=Q+1:LINE(553+Q*20,303)-(567+Q*20,433),PSET,7,B:FOR Z=0 TO W*4:NEXT
  80. 2230 IF PAD(1)=7 AND Q<>0 THEN LINE(553+Q*20,303)-(567+Q*20,433),PSET,0,B:Q=Q-1:LINE(553+Q*20,303)-(567+Q*20,433),PSET,7,B:FOR Z=0 TO W*4:NEXT
  81. 2240 IF PTRIG(1)=1 THEN P=1:WAIT 10
  82. 2250 WEND
  83. 2260 '
  84. 2270 P=0
  85. 2280 LINE(550,300)-(610,436),PSET,0,BF
  86. 2290 GOTO 1260
  87. 2300 '
  88. 3000 '========その他のサブルーチン========
  89. 3010 *DL
  90. 3020 LINE(200+XX*20,80+YY*20)-(220+XX*20,100+YY*20),PSET,0,B:RETURN
  91. 3030 *PL
  92. 3040 LINE(200+XX*20,80+YY*20)-(220+XX*20,100+YY*20),PSET,7,B:RETURN
  93. 3050 *GP
  94. 3060 GET@A(208+XX*20,88+YY*20)-(208+XX*20,88+YY*20),A%
  95. 3070 PUT@A(XX+XAX,YY+YAY)-(XX+XAX,YY+YAY),A%,PSET,1,1
  96. 3080 PUT@A(XX*5,300+YY*5)-(XX*5,300+YY*5),A%,PSET,5,5
  97. 3090 PUT@A(XX*2,150+YY*2)-(XX*2,150+YY*2),A%,PSET,2,2
  98. 3100 RETURN
  99. 3110 '
  100. 4000 DATA 0,0,0        'ﾄ このDATAは16色パレットの
  101. 4010 DATA 0,0,16       '   32段階の初期値です。
  102. 4020 DATA 16,0,0       '   Ｒ･Ｇ･Ｂの順に並んでいます。
  103. 4030 DATA 16,0,16      '   肌色などよく使われる色を
  104. 4040 DATA 0,16,0       '   作っておくと便利かと思われます。
  105. 4050 DATA 0,16,16      '   （絵を読み込んでパレットが
  106. 4060 DATA 16,16,0      '     変わっても、数値は変わらない為）
  107. 4070 DATA 16,16,16
  108. 4080 DATA 8,8,8
  109. 4090 DATA 0,0,31
  110. 4100 DATA 31,0,0
  111. 4110 DATA 31,0,31
  112. 4120 DATA 0,31,0
  113. 4130 DATA 0,31,31
  114. 4140 DATA 31,31,0
  115. 4150 DATA 31,31,31
  116. 4160 '
  117. 5000 *SCRB
  118. 5010 LINE(201,61)-(519,69),PSET,0,BF
  119. 5020 LINE(531,81)-(539,399),PSET,0,BF
  120. 5030 LINE(200+XAX*2.5!,61)-(240+XAX*2.5!,69),PSET,7,BF
  121. 5040 LINE(531,80+YAY*2.5!)-(539,120+YAY*2.5!),PSET,7,BF
  122. 5050 RETURN
  123. 5099 '
  124. 5100 *CHARA_LOAD
  125. 5110 GET@A(XAX,YAY)-(XAX+15,YAY+15),SC%
  126. 5120 GET@A(XAX,YAY)-(XAX+31,YAY+31),X%:PUT@A(200,80)-(215,95),SC%,PSET,20,20:PUT@(200,80)-(519,399),ZZ%,PSET,7
  127. 5130 PUT@A(0,150)-(31,181),X%,PSET,2,2:PUT@A(0,300)-(31,331),X%,PSET,5,5
  128. 5140 RETURN
  129. 5199 '
  130. 5200 *SAVE
  131. 5210 INPUT "SAVE file name";SA$
  132. 5220 IF SA$="" THEN CLS 4:GOTO 8040
  133. 5230 SAVE@ SA$+".TIF",(0,0)-(MSX+15,MSY+15),1
  134. 5240 CLS 4:GOTO 8040
  135. 5299 '
  136. 5300 *LOAD
  137. 5310 INPUT "LOAD file name";SA$
  138. 5320 IF SA$="" THEN CLS 4:GOTO 8040
  139. 5330 LOAD@ SA$+".TIF"
  140. 5340 GET@A(XAX,YAY)-(XAX+15,YAY+15),SC%:PUT@A(200,80)-(215,95),SC%,PSET,20,20:PUT@(200,80)-(519,399),ZZ%,PSET,7
  141. 5350 GET@A(XAX,YAY)-(XAX+31,YAY+31),X%
  142. 5360 PUT@A(0,150)-(31,181),X%,PSET,2,2:PUT@A(0,300)-(31,331),X%,PSET,5,5
  143. 5370 CLS 4
  144. 5380 GOTO 8040
  145. 5399 '
  146. 5400 *WAIT
  147. 5410 INPUT "WAIT"+STR$(W);W$
  148. 5420 IF W$="" THEN CLS 4:RETURN
  149. 5430 W=VAL(W$):CLS 4:RETURN
  150. 5499 '
  151. 5500 *CL
  152. 5510 PRINT "よいですか？ Y･RUN / N･SELECT"
  153. 5520 WHILE PTRIG(1)<>4 AND PTRIG(1)<>8:WEND
  154. 5530 IF PTRIG(1)=8 THEN CLS 4:RETURN
  155. 5540 LINE(200,80)-(519,399),PSET,0,BF
  156. 5550 PUT@(200,80)-(519,399),ZZ%
  157. 5560 LINE(0,0)-(127,127),PSET,0,BF
  158. 5570 LINE(0,150)-(63,213),PSET,0,BF
  159. 5580 LINE(0,300)-(159,459),PSET,0,BF
  160. 5590 GOSUB *DL:CLS 4:RETURN
  161. 5599 '
  162. 5600 *ED
  163. 5610 PRINT "終了します。 Y･RUN / N･SELECT"
  164. 5620 WHILE PTRIG(1)<>4 AND PTRIG(1)<>8:WEND
  165. 5630 IF PTRIG(1)=8 THEN CLS 4:GOTO 8040 ELSE END
  166. 5699 '
  167. 5700 *POF
  168. 5710 PRINT "電源を切ります。 Y･RUN / N･SELECT"
  169. 5720 WHILE PTRIG(1)<>4 AND PTRIG(1)<>8:WEND
  170. 5730 IF PTRIG(1)=8 THEN CLS 4:GOTO 8040 ELSE WAIT 100:OUT &H22,64
  171. 5799 '
  172. 5800 *GT
  173. 5810 GET@A(XAX,YAY)-(XAX+15,YAY+15),GTPT%
  174. 5820 BEEP 1:WAIT 10:BEEP 0:GOTO 8040
  175. 5830 *PT
  176. 5840 PUT@A(0,150)-(15,165),GTPT%,PSET,2,2:PUT@A(0,300)-(15,315),GTPT%,PSET,5,5
  177. 5850 PUT@A(XAX,YAY)-(XAX+15,YAY+15),GTPT%,PSET
  178. 5860 PUT@A(200,80)-(215,95),GTPT%,PSET,20,20:PUT@(200,80)-(519,399),ZZ%,PSET,7
  179. 5870 BEEP 1:WAIT 10:BEEP 0:GOTO 8040
  180. 5899 '
  181. 6000 *SCROLL
  182. 6010 WHILE (1)
  183. 6020 PD=PAD(1):PT=PTRIG(1)
  184. 6030 IF PT=0 AND OPT=1 THEN OPT=0:GOTO 6150
  185. 6040 IF PT>=2 THEN 6290
  186. 6050 IF PD=1 AND YAY<>0 THEN YAY=YAY-1
  187. 6060 IF PD=3 AND XAX<>MSX THEN XAX=XAX+1
  188. 6070 IF PD=5 AND YAY<>MSY THEN YAY=YAY+1
  189. 6080 IF PD=7 AND XAX<>0 THEN XAX=XAX-1
  190. 6090 IF PD=0 THEN 6020
  191. 6100 LINE(201,61)-(519,69),PSET,0,BF
  192. 6110 LINE(531,81)-(539,399),PSET,0,BF
  193. 6120 LINE(200+XAX*2.5!,61)-(240+XAX*2.5!,69),PSET,7,BF
  194. 6130 LINE(531,80+YAY*2.5!)-(539,120+YAY*2.5!),PSET,7,BF
  195. 6140 IF PT=1 THEN OPT=1:GOTO 6020
  196. 6150 GET@A(XAX,YAY)-(XAX+15,YAY+15),SC%
  197. 6160 GET@A(XAX,YAY)-(XAX+31,YAY+31),X%:PUT@A(200,80)-(215,95),SC%,PSET,20,20
  198. 6170 PUT@A(0,150)-(31,181),X%,PSET,2,2:PUT@A(0,300)-(31,331),X%,PSET,5,5
  199. 6180 LX=XAX:Q=0:IF LX<16 THEN 6210
  200. 6190 WHILE Q=0:LX=LX-16:IF LX<16 THEN Q=1
  201. 6200 WEND
  202. 6210 LY=YAY:Q=0:IF LY<16 THEN 6240
  203. 6220 WHILE Q=0:LY=LY-16:IF LY<16 THEN Q=1
  204. 6230 WEND
  205. 6240 LINE(520-LX*20,80)-(520-LX*20,399),PSET,7
  206. 6250 LINE(200,400-LY*20)-(519,400-LY*20),PSET,7
  207. 6260 IF LX=0 THEN LINE(200,80)-(200,399),PSET,7
  208. 6270 IF LY=0 THEN LINE(200,80)-(519,80),PSET,7
  209. 6280 WEND
  210. 6290 PUT@(200,80)-(519,399),ZZ%,PSET,7:BEEP 1:WAIT 10:BEEP 0:GOTO 8040
  211. 6300 '
  212. 7000 '========エラー処理========
  213. 7010 *ER
  214. 7020 IF ERR=64 BEEP 1:PRINT "そのファイルは存在しています。":GOTO 7070 ELSE 7030
  215. 7030 IF ERR=63 BEEP 1:PRINT "そのファイルは存在しません。":GOTO 7050 ELSE 7040
  216. 7040 IF ERR=55 BEEP 1:PRINT "ファイル名が正しくありません。":GOTO 7050
  217. 7050 WAIT 20:BEEP 0:PRINT "HIT ANY KEY":WHILE INKEY$="":WEND:RESUME 5370
  218. 7060 END
  219. 7070 WAIT 20:BEEP 0:PRINT "上書きしますか？ Y･RUN / N･SELECT"
  220. 7080 WHILE PTRIG(1)<>4 AND PTRIG(1)<>8:WEND
  221. 7090 IF PTRIG(1)=8 THEN CLS 4:RESUME 5370
  222. 7100 KILL SA$+".TIF"
  223. 7110 SAVE@ SA$+".TIF",(0,0)-(MSX+15,MSY+15),1
  224. 7120 CLS 4:RESUME 5370
  225. 7130 '
  226. 8000 '========メニュー(参考程度に)========
  227. 8010 *MENU
  228. 8020 MENUX=0:MENUY=0
  229. 8030 LINE(202,8)-(261,26),PSET,7,B
  230. 8040 WHILE (1)
  231. 8050 WHILE PAD(1)=0 AND PTRIG(1)=0:WEND
  232. 8060 LINE(202+MENUX*64,8+MENUY*20)-(261+MENUX*64,26+MENUY*20),PSET,0,B
  233. 8070 PD=PAD(1):PT=PTRIG(1)
  234. 8080 IF PD=1 AND MENUY<>0 THEN MENUY=MENUY-1
  235. 8090 IF PD=3 AND MENUX<>4 THEN MENUX=MENUX+1
  236. 8100 IF PD=5 AND MENUY<>1 THEN MENUY=MENUY+1
  237. 8110 IF PD=7 AND MENUX<>0 THEN MENUX=MENUX-1
  238. 8120 LINE(202+MENUX*64,8+MENUY*20)-(261+MENUX*64,26+MENUY*20),PSET,7,B
  239. 8130 IF PT=1 THEN GOTO 8160
  240. 8140 IF PT=2 THEN WAIT 20:LINE(202+MENUX*64,8+MENUY*20)-(261+MENUX*64,26+MENUY*20),PSET,0,B:GOTO 1010
  241. 8150 WAIT 10:WEND
  242. 8160 '
  243. 8170 IF MENUY=1 THEN GOTO 8240
  244. 8180 IF MENUX=0 THEN GOTO 1240
  245. 8190 IF MENUX=1 THEN GOSUB *WAIT:GOTO 8040
  246. 8200 IF MENUX=2 THEN GOTO *SAVE
  247. 8210 IF MENUX=3 THEN GOTO *LOAD
  248. 8220 IF MENUX=4 THEN GOSUB *CL:GOTO 8040
  249. 8230 END
  250. 8240 '
  251. 8250 IF MENUX=0 THEN GOTO *GT
  252. 8260 IF MENUX=1 THEN GOTO *PT
  253. 8270 IF MENUX=2 THEN BEEP 1:WAIT 30:BEEP 0:GOTO *SCROLL
  254. 8280 IF MENUX=3 THEN GOTO *POF
  255. 8290 IF MENUX=4 THEN GOTO *ED
  256. 8300 GOTO 8040
  257.